home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
lsp
/
module.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
4KB
|
177 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "module.h"
init_module(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
VV[0]->s.s_stype=(short)stp_special;
if(VV[0]->s.s_dbind == OBJNULL){
VV[0]->s.s_dbind = Cnil;}
MF(VV[11],L1,start,size,data);
MF(VV[12],L2,start,size,data);
MF(VV[13],L3,start,size,data);
MF(VV[14],L4,start,size,data);
vs_top=vs_base=base;
}
/* function definition for PROVIDE */
static L1()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(1);
vs_top=sup;
TTL:;
base[1]= coerce_to_string(base[0]);
base[2]= symbol_value(VV[0]);
base[3]= VV[1];
base[4]= symbol_function(VV[15]);
vs_top=(vs_base=base+1)+4;
Ladjoin();
vs_top=sup;
setq(VV[0],vs_base[0]);
base[1]= symbol_value(VV[0]);
vs_top=(vs_base=base+1)+1;
return;
}
/* function definition for REQUIRE */
static L2()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
bds_check;
if(vs_top-vs_base<1) too_few_arguments();
if(vs_top-vs_base>2) too_many_arguments();
vs_base=vs_base+1;
if(vs_base>=vs_top){vs_top=sup;goto T7;}
vs_top=sup;
goto T8;
T7:;
base[2]= coerce_to_string(base[0]);
vs_top=(vs_base=base+2)+1;
Lstring_downcase();
vs_top=sup;
base[1]= vs_base[0];
T8:;
bds_bind(VV[2],VV[3]);
base[3]= coerce_to_string(base[0]);
base[4]= symbol_value(VV[0]);
base[5]= VV[1];
base[6]= symbol_function(VV[15]);
vs_top=(vs_base=base+3)+4;
Lmember();
vs_top=sup;
if((vs_base[0])!=Cnil){
goto T12;}
if(!(type_of(base[1])!=t_cons)){
goto T19;}
base[3]= base[1];
vs_top=(vs_base=base+3)+1;
Lload();
bds_unwind1;
return;
T19:;
base[3]= base[1];
T23:;
if(!(endp(base[3]))){
goto T24;}
base[4]= Cnil;
vs_top=(vs_base=base+4)+1;
bds_unwind1;
return;
T24:;
base[4]= car(base[3]);
vs_top=(vs_base=base+4)+1;
Lload();
vs_top=sup;
base[3]= cdr(base[3]);
goto T23;
T12:;
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
}
/* function definition for DOCUMENTATION */
static L3()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(2);
vs_top=sup;
TTL:;
{object V1= base[1];
if((V1!= VV[16]))goto T33;
base[2]= get(base[0],VV[4],Cnil);
vs_top=(vs_base=base+2)+1;
return;
T33:;
if((V1!= VV[17]))goto T34;
base[2]= get(base[0],VV[5],Cnil);
vs_top=(vs_base=base+2)+1;
return;
T34:;
if((V1!= VV[18]))goto T35;
base[2]= get(base[0],VV[6],Cnil);
vs_top=(vs_base=base+2)+1;
return;
T35:;
if((V1!= VV[19]))goto T36;
base[2]= get(base[0],VV[7],Cnil);
vs_top=(vs_base=base+2)+1;
return;
T36:;
if((V1!= VV[20]))goto T37;
base[2]= get(base[0],VV[8],Cnil);
vs_top=(vs_base=base+2)+1;
return;
T37:;
base[2]= VV[9];
base[3]= base[1];
vs_top=(vs_base=base+2)+2;
Lerror();
return;}
}
/* function definition for FIND-DOCUMENTATION */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
check_arg(1);
vs_top=sup;
TTL:;
if(endp(base[0])){
goto T40;}
if(!(endp(cdr(base[0])))){
goto T41;}
T40:;
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
T41:;
base[2]= car(base[0]);
vs_top=(vs_base=base+2)+1;
Lmacroexpand();
vs_top=sup;
base[1]= vs_base[0];
if(!(type_of(base[1])==t_string)){
goto T48;}
vs_top=(vs_base=base+1)+1;
return;
T48:;
if(!(type_of(base[1])==t_cons)){
goto T51;}
if(!(car(base[1])==VV[10])){
goto T51;}
base[0]= cdr(base[0]);
goto TTL;
T51:;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}